perm filename ODT.SAI[PIC,HE] blob
sn#423181 filedate 1979-03-07 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 entry odt
C00018 ENDMK
C⊗;
entry odt;
begin
comment
**************************************************************
This module implements procedures acting on the .thr files.
*************************************************************;
require "define.sai" source!file;
require "grafix.dcl" source!file;
require "direct.dcl" source!file;
require "picbuf.dcl" source!file;
require "tenexio.sai" source!file;
define reject = "1";
integer thrbuf,outbuf,dirbuf,tbuf;
integer array header [0:127];
define savethr = "header[127]",
saveft = "header[126]",
savedirinfo = "header[125]",
edgecount = "header[32]";
external string picture;
string s;
integer threshold, colsz, rowsz, cscan, rscan, dirinfo;
REAL FT;
internal simple procedure initial;
bufinit;
internal simple procedure odinit;
begin
indmp("", picture & ".out",outbuf := fndbuf,usc);
indmp("", picture & ".dir",dirbuf := fndbuf,usc);
colsz := colms(outbuf); rowsz := rows(outbuf);
print(" ",picture," is ",rowsz," X ",colsz,".",crlf);
gethdr(header,dirbuf);
dirinfo := header[124] * 2;
if dirinfo neq 8 and dirinfo neq 12 then
do begin
iprmpt(" .dir files. 8 or 12 ? ",dirinfo);
end until dirinfo = 8 or dirinfo = 12;
end; "odinit"
internal simple procedure tinit;
begin
indmp("",picture & ".thr",thrbuf := fndbuf,usc);
gethdr(header,thrbuf);
print(" This .thr file is made using thresholds of ");
print(savethr," and ",saveft*0.1,crlf);
print(" .dir files info: ",savedirinfo,crlf);
print(" Hit <crlf>, if satisfied with these nos.");
s := intty;
colsz := COLMS(THRBUF); rowsz := ROWS(THRBUF);
threshold := savethr;
end;
internal simple procedure tclose;
begin
boolean save;
save := false;
bprmpt(" Save the .thr file ? ",save);
if save then
begin
gethdr(header,thrbuf);
savethr := threshold; savedirinfo := dirinfo;
saveft := ft * 10;
puthdr(header,thrbuf);
outdmp("",picture & ".thr",thrbuf,usc);
end;
frebuf(thrbuf);
end;
internal simple procedure tfree;
frebuf(thrbuf);
internal simple procedure odfree;
begin
frebuf(outbuf); frebuf(dirbuf);
end;
procedure threebythree;
begin " threebythree "
integer mag1, mag2, cmag, dir1, dir2, cdir, dir, temp;
integer r1, r2, c1, c2;
comment This procedure looks at the 8-neighbours of a pixel
and decides whether an edge element is present or not.
The 8-neighbors along with the pixel under consideration
form a 3x3 matrix;
if getpnt(rscan,cscan,tbuf) neq reject then
begin
cdir := getpnt(rscan,cscan,dirbuf); temp := growthdir(cdir);
r1 := rscan; c1 := cscan; r2 := r1; c2 := c1;
nextcoord((temp+2) mod 8, r1, c1);
nextcoord((temp+6) mod 8, r2, c2);
dir1 := getpnt(r1,c1,dirbuf); dir2 := getpnt(r2,c2,dirbuf);
if samedir(dir1,cdir,2) and samedir(dir2,cdir,2) then
begin
cmag := getpnt(rscan,cscan,outbuf);
mag1 := getpnt(r1,c1,outbuf); mag2 := getpnt(r2,c2,outbuf);
if ((cmag geq mag1) and (cmag geq mag2)) and
(cmag geq threshold) and
(mag1 geq ft*cmag) and (mag2 geq ft*cmag) then
begin
comment
This code will do some extra checking in case we do not
find a peak due to the central pixel. (The profile will
have a flat top).;
real slope1, slope2;
integer rr, cc;
slope2 := 0.0; slope1 := 1.0;
if cmag = mag1 then
begin
rr := rscan + (r1-rscan)*2; cc := cscan + (c1-cscan)*2;
slope1 := getpnt(rr,cc,outbuf)/cmag;
slope2 := mag2/cmag;
end else if cmag = mag2 then
begin
rr := rscan + (r2-rscan)*2; cc := cscan + (c2-cscan)*2;
slope1 := getpnt(rr,cc,outbuf)/mag2;
slope2 := mag1/cmag;
end;
if slope2 leq slope1 then
begin
putpnt(r1,c1,reject,tbuf); PUTPNT(R1,C1,ZERO,THRBUF);
putpnt(rscan,cscan,cmag,thrbuf);
putpnt(r2,c2,reject,tbuf); PUTPNT(R2,C2,ZERO,THRBUF);
end;
end; "peakcheck"
end; "samedir"
end ; " reject "
end; "threebythree"
procedure eightdir;
begin " eightdir "
integer mag1, mag2, cmag, dir1, dir2, cdir, dir, temp;
integer r1, r2, c1, c2;
comment This procedure looks at the 8-neighbours of a pixel
and decides whether an edge element is present or not.
The 8-neighbors along with the pixel under consideration
form a 3x3 matrix;
if getpnt(rscan,cscan,tbuf) neq reject then
begin
cdir ← getpnt(rscan,cscan,dirbuf); temp ← cdir mod 8;
r1 ← rscan; c1 ← cscan; r2 ← r1; c2 ← c1;
nextcoord((temp+2) mod 8, r1, c1);
nextcoord((temp+6) mod 8, r2, c2);
dir1 ← getpnt(r1,c1,dirbuf); dir2 ← getpnt(r2,c2,dirbuf);
if same8dir(dir1,cdir,2) and same8dir(dir2,cdir,2) then
begin
cmag ← getpnt(rscan,cscan,outbuf);
mag1 ← getpnt(r1,c1,outbuf); mag2 ← getpnt(r2,c2,outbuf);
if ((cmag geq mag1) and (cmag geq mag2)) and
(cmag geq threshold) and
(mag1 geq ft*cmag) and (mag2 geq ft*cmag) then
begin
comment
This code will do some extra checking in case we do not
find a peak due to the central pixel. (The profile will
have a flat top).;
real slope1, slope2;
integer rr, cc;
slope2 ← 0.0; slope1 ← 1.0;
if cmag = mag1 then
begin
rr ← rscan + (r1-rscan)*2; cc ← cscan + (c1-cscan)*2;
slope1 ← getpnt(rr,cc,outbuf)/cmag;
slope2 ← mag2/cmag;
end else if cmag = mag2 then
begin
rr ← rscan + (r2-rscan)*2; cc ← cscan + (c2-cscan)*2;
slope1 ← getpnt(rr,cc,outbuf)/mag2;
slope2 ← mag1/cmag;
end;
if slope2 leq slope1 then
begin
putpnt(r1,c1,reject,tbuf); PUTPNT(R1,C1,ZERO,THRBUF);
putpnt(rscan,cscan,cmag,thrbuf);
putpnt(r2,c2,reject,tbuf); PUTPNT(R2,C2,ZERO,THRBUF);
end;
end; "peakcheck"
end; "same8dir"
end ; " reject "
end; "eightdir"
procedure display(integer file);
begin
integer size;
comment: Makes a binary plot of pixel
elements of a digitised picture.;
integer fptr, data;
size := colsz; if rowsz>size then size := rowsz;
pctr(0); initt(450);
vwindo(0.0,1.41*size,-1.06*size,1.06*size);
for rscan := 1 step 1 until rowsz do
begin
fptr := inptr(rscan,1,file);
for cscan := 1 step 1 until colsz do
begin
data := ildb(fptr);
if data geq threshold then
pointa(1.0*cscan,-1.0*rscan);
end;
end;
endpct;
end; " display "
internal simple procedure tdisplay;
display(thrbuf);
internal simple procedure tmak;
begin
boolean morethreshold;
morethreshold := false;
getbuf(rowsz,colsz,byte,thrbuf := fndbuf);
do begin
getbuf(rowsz,colsz,onebit,tbuf := fndbuf);
iprmpt(" Thresholding on peaks: ",threshold);
rprmpt(" Fractional threshold in steps of 0.1: ",ft);
msec := trtime;
if dirinfo = 8 then
for rscan := 3 step 1 until rowsz - 2 do
begin
for cscan := 3 step 1 until colsz - 2 do
eightdir;
if rscan mod 50 = 0 then
print(" ",rscan," rows scanned.",crlf);
end ELSE
if dirinfo = 12 then
for rscan := 3 step 1 until rowsz - 2 do
begin
for cscan := 3 step 1 until colsz - 2 do
threebythree;
if rscan mod 50 = 0 then
print(" ",rscan," rows scanned.",crlf);
end;
frebuf(tbuf);
msec := trtime - msec;
print(" Time for making the .thr file: ",msec,crlf);
psout(" Do you want thresholded display: "); s := intty;
if s = "y" or s = "Y" then display(thrbuf);
psout(" DO you want unthinned display: "); s := intty;
if s = "y" or s = "Y" then display(outbuf);
bprmpt(" Any more thresholds ?",morethreshold);
if morethreshold then getbuf(rowsz,colsz,onebit,tbuf := fndbuf);
end until not morethreshold;
end; "tmak"
internal procedure tzoom;
begin "tzoom"
comment;
integer size, rwsz, cwsz, rbeg, cbeg, rend, cend;
boolean more, rcok;
integer tptr;
clipinit(rowsz,colsz); more := false;
do begin
begindisplay;
getwindow(rbeg,cbeg,rend,cend);
for rscan := rbeg step 1 until rend do
begin
tptr := inptr(rscan,cbeg,thrbuf);
for cscan := cbeg step 1 until cend do
begin
if ildb(tptr) geq savethr then
pointa(1.0*cscan,-1.0*rscan);
end;
end;
legend(picture & ".thr");
endisplay;
bprmpt(" Any more ?",more);
end until not(more);
end "tzoom" ;
internal simple procedure tprintout;
begin
external procedure lptdmp(boolean decimal; integer b,r,c);
lptdmp(true,thrbuf,rowsz,colsz);
end;
internal simple procedure tcount;
begin
integer tptr;
msec := trtime;
for rscan := 1 step 1 until rowsz do
begin
tptr := inptr(rscan,1,thrbuf);
for cscan := 1 step 1 until colsz do
begin
if ildb(tptr) neq 0 then edgecount := edgecount + 1;
end;
end;
print(" No of edge elements,",edgecount,crlf);
print(" Time for edge counting: ",trtime-msec," ms.",crlf);
end;
end